home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / qbfaqr01.zip / PANSI.BAS < prev    next >
BASIC Source File  |  1992-08-09  |  16KB  |  527 lines
  1. '****PART 1****
  2. 'PANSI.BAS
  3. 'ANSI emulator for QuickBASIC 4.5(maby PDS) v1.00
  4. 'By Richard Geldreich June 3, 1992
  5. 'Don't forget that "CALL INTERRUPT"  is
  6. 'used- "INTRPT.OBJ" in the QB.LIB library...
  7.  
  8. 'Thanks to Mike Gallas... the person who gave me
  9. 'the idea! Hope this helps! This driver recognizes all but
  10. '3 ANSI.SYS escape sequences(the 3 not supported aren't used
  11. 'in commumication...)
  12.  
  13. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  14. '! Don't forget to modify the "SendStatus" procedure for your !
  15. '!                       comm package!                        !
  16. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  17.  
  18. 'I welcome any suggestions or ideas about this program... It
  19. '_should_ emulate DOS's ANSI.SYS device driver...
  20. 'This program is in the public domain; do what you want with it!
  21. 'Have a ball!! Just try and give me some credit. Thanks.
  22. 'I have tested this driver out with many BBS's and door programs and
  23. 'it works fine. Please test this driver out before you release it
  24. 'in a program!!!
  25.  
  26. 'NOTE: This program assumes that the current segment is always
  27. 'pointing twards the video buffer!! If you change the current
  28. 'segment don't forget to change it back or sparks will fly when you
  29. 'write to the screen! (see GetVSeg or RestoreVS)
  30.  
  31. 'Info on usage:
  32. 'ClearScreen- used internally by the PrintAnsi procedure- you may
  33. 'use it to clear the current window(the current background color
  34. 'is used in the clear). ONLY the current window is cleared.
  35.  
  36. 'CursorControl A- if A is non-zero then the SetCursor routine(which
  37. 'is called by PrintAnsi) will update the cursor whenever it is moved.
  38. 'If it is zero then SetCursor won't touch the cursor's position.
  39.  
  40. 'GetVSeg- Returns the current video segment.
  41.  
  42. 'Init- you must call this before PrintAnsi can work properly. Sets
  43. 'up the color translation table, the screen(defualts to 80x25), and
  44. 'tests the adapter to see if it's monochrome or color(***hope that
  45. 'works***).
  46.  
  47. 'PrintAnsi Char- where Char is an ASCII code from 0-255. Recognizes
  48. 'ANSI escape sequences(of course!). Processes the character and
  49. 'updates the display, if needed.
  50.  
  51. 'PrintString A$- prints a string to the display. Calls PrintAnsi for
  52. 'each character.
  53.  
  54. 'RestoreVS- since PrintAnsi always assumes that DEF SEG points twards
  55. 'the video segment, you must restore the video segment after you change
  56. 'it. (See pansi2.bas for an example of this.) See GetVSeg also.
  57.  
  58. 'ScrollUpScreen- scrolls up the current window. Uses a BIOS call.
  59. 'Normally used internally by PrintAnsi.
  60.  
  61. 'SendStatus- sends a CPR sequence to the receiver.
  62. 'In other words, SendStatus will output the current X and Y coordinates
  63. 'of the cursor to the remote terminal. Used by some BBS's and doors
  64. 'to see if the user's terminal has ANSI capibilities. You must modify
  65. 'this procedure to output the status string to your comm package!
  66. '(this is used internally by PrintAnsi)
  67.  
  68. 'SetCursor- moves the cursor to it's correct position(it doesn't turn
  69. 'it on however- use the LOCATE ,,1 command to do that). This procedure
  70. 'should work on all adapters, but I haven't tested it out on many
  71. 'cards yet... Use this to restore the cursor to where it should be
  72. 'after you move it.
  73.  
  74. 'SetWindow Lx,Ly,Hx,Hy- defines a window where all text is printed.
  75. 'Lx and Ly are the upper-left lines of the window(where 1,1 is the
  76. 'upper corner of the screen) and Hx and Hy are the lower-right
  77. 'coordinates of the window. For instance, if you're in the 80x50
  78. 'mode, you must issue this command:
  79. 'SetWindow 1,1,80,50
  80. 'to print to the entire screen. The current cursor position is moved
  81. 'to the upper left corner of the new window.
  82.  
  83. 'That's all! You can add more functions if you need them; I've
  84. 'documented the PrintAnsi procedure enough for you to get
  85. 'a good idea of how it works. As soon as any bugs are worked out
  86. 'I'll code this program in assembly and post it(trust me: IT WILL
  87. 'FLY!).
  88.  
  89. 'Notes on ANSI music:
  90. 'The format for ANSI music is ESC[MF and then add the music in the
  91. 'basic play format. Terminate it with a CHR$(14). I didn't implemet
  92. '****PART 2****
  93. 'ANSI music because I haven't seen anything that uses it: but if
  94. 'anybody needs it I'll be glad to add it! ANSI.SYS does not support
  95. 'ANSI music(... what a shame).
  96.  
  97. DEFINT A-Z
  98. '$INCLUDE: 'pansi.bi'
  99.  
  100. TYPE RegType
  101.      Ax    AS INTEGER
  102.      Bx    AS INTEGER
  103.      Cx    AS INTEGER
  104.      Dx    AS INTEGER
  105.      bp    AS INTEGER
  106.      si    AS INTEGER
  107.      di    AS INTEGER
  108.      flags AS INTEGER
  109. END TYPE
  110.  
  111. DIM SHARED Xpos, Ypos               'cursor's position
  112. DIM SHARED MinX, MinY, MaxX, MaxY   'current window
  113. DIM SHARED SaveX, SaveY             'used by SCR and RCP
  114. DIM SHARED Colors(7), Attribute
  115. DIM SHARED CursorOn, VideoSegment
  116. DIM SHARED Monochrome               'monochrome adapter flag
  117.  
  118. CONST True = -1, False = NOT True   'usefull stuff
  119.  
  120. 'The color translation table is used to translate an ANSI color
  121. 'to a screen color.
  122. ColorTable:
  123.     DATA 0,4,2,6,1,5,3,7
  124.  
  125.  
  126. 'The following code is not needed... It's only for testing!
  127. 'simple test
  128. Init                    'must do this!
  129. SetWindow 1, 1, 80, 25  'normal window
  130. ClearScreen             'clear the window
  131. LOCATE , , 1            'turn cursor on
  132. CursorControl 1         'allow updating of cursor
  133.  
  134. 'DO
  135. '    A$ = INKEY$: IF A$ <> "" THEN PrintString A$
  136. 'LOOP
  137.  
  138. A$ = CHR$(27) + "[0;1;5;44;31mHello Everybody! "
  139. A$ = A$ + CHR$(27) + "[0;1;44;33mR.G. Here!"
  140. DO: printstring A$: LOOP UNTIL INKEY$ <> ""
  141. printstring CHR$(27) + "[0m" + CHR$(27) + "[2J"
  142.  
  143. 'Clears the current window.
  144. SUB ClearScreen
  145.     DIM Regs AS RegType
  146.     Regs.Ax = &H600
  147.     A& = Attribute * 256&
  148.     IF A& > 32767 THEN A = A& - 65536 ELSE A = A&
  149.     Regs.Bx = A
  150.     Regs.Cx = (MinY * 256&) + MinX - 257
  151.     Regs.Dx = (MaxY * 256&) + MaxX - 257
  152.     CALL interrupt(&H10, Regs, Regs)
  153. END SUB
  154.  
  155. 'Enables or disables cursor updating.
  156. SUB CursorControl (A)
  157.     IF A THEN
  158.         CursorOn = True
  159.     ELSE
  160.         CursorOn = False
  161.     END IF
  162. END SUB
  163.  
  164. 'Returns the current video segment.
  165. FUNCTION GetVSeg
  166.     GetVSeg = VideoSegment
  167. END FUNCTION
  168.  
  169. 'Initilizes everything.
  170. SUB Init
  171.     DIM Regs AS RegType
  172.     'window defualts to 80x25
  173.     SetWindow 1, 1, 80, 25
  174.     'default color:white on black
  175.     Attribute = 7
  176.     'set up saveX and saveY just in case
  177.     'a RCP sequence is received before a SCR
  178.     'sequence.
  179.     SaveX = MinX: SaveY = MinY
  180.  
  181.     'current level is set to normal
  182.     Level = 0
  183.  
  184. '****PART 3****
  185.     'read in color translation table
  186.     RESTORE ColorTable
  187.     FOR A = 0 TO 7: READ Colors(A): NEXT
  188.  
  189.     '***********************************
  190.     'The following code uses a BIOS call
  191.     'to test if adaptor is monochrome or
  192.     'color. This **should** work on all
  193.     'adapters(hee hee ya right) but who
  194.     'knows!
  195.     '***********************************
  196.  
  197.     Regs.Ax = 15 * 256
  198.     CALL interrupt(&H10, Regs, Regs)
  199.     'if AL=7 then card is monochrome.
  200.     IF (Regs.Ax AND 255) = 7 THEN
  201.         VideoSegment = &HB000
  202.         Monochrome = True
  203.     ELSE
  204.         VideoSegment = &HB800
  205.         Monochrome = False
  206.     END IF
  207.     'Set segment to the screen.
  208.     DEF SEG = VideoSegment
  209. END SUB
  210.  
  211. 'Prints an ASCII character on the screen; filters out
  212. 'ANSI escape sequences and parses them.
  213. SUB PrintAnsi (Char) STATIC
  214.     DIM Parameters(10)
  215.  
  216.     SELECT CASE Level
  217.     CASE 0
  218.         'normal mode
  219.         GOSUB ProcessChar
  220.     CASE 1
  221.         'Level=1 after a chr$(27) is received.
  222.         'valid escape sequence?
  223.         IF Char <> 91 THEN
  224.             Level = 0
  225.             GOSUB ProcessChar
  226.         ELSE
  227.             'a valid escape sequence has been received:
  228.             'initilize all the neat stuff...
  229.             Level = 2
  230.             CurrentParameter = 0
  231.             NumParameters = 0
  232.             ValidParameter = False
  233.             FOR A = 1 TO 5: Parameters(A) = 0: NEXT
  234.         END IF
  235.     CASE 2
  236.         'inside an escape sequence
  237.         GOSUB ProcessCode
  238.     END SELECT
  239. EXIT SUB
  240.  
  241. ProcessChar:
  242.     'processes a non-ANSI code
  243.     SELECT CASE Char
  244.     'process new page code
  245.     '(clears to screen: this is something
  246.     'ANSI.SYS doesn't do)
  247.     CASE 12
  248.         ClearScreen
  249.         Xpos = MinX: Ypos = MinY
  250.         SetCursor
  251.     'process escape character
  252.     CASE 27
  253.         Level = 1
  254.     'process enter
  255.     CASE 13
  256.         Xpos = MinX
  257.         SetCursor
  258.     'process line feed
  259.     CASE 10
  260.         Ypos = Ypos + 1
  261.         IF Ypos > MaxY THEN Ypos = MaxY: ScrollUpScreen
  262.         SetCursor
  263.     'process backspace(non-destructive)
  264.     CASE 8
  265.         Xpos = Xpos - 1
  266.         IF Xpos < MinX THEN Xpos = MinX
  267.         SetCursor
  268.     'process tab key(tab stops=8)
  269.     CASE 9
  270.         Xpos = ((Xpos \ 8) + 1) * 8
  271.         IF Xpos > 80 THEN Xpos = 80
  272.         SetCursor
  273.     'process bell
  274.     CASE 7
  275.         'don't substitute a "BEEP" statement here!
  276.  
  277. '****PART 4****
  278.         'BEEP resets the cursor to where QB thinks it is!
  279.         SOUND 3150, 1.3
  280.     'any other character is sent to the screen
  281.     CASE ELSE
  282.         'prints a character to the screen
  283.         A = Xpos * 2 + Ypos * 160 - 162
  284.         POKE A, Char: POKE A + 1, Attribute
  285.         Xpos = Xpos + 1
  286.         IF Xpos > MaxX THEN Xpos = MinX: Ypos = Ypos + 1
  287.         IF Ypos > MaxY THEN Ypos = MaxY: ScrollUpScreen
  288.         SetCursor
  289.     END SELECT
  290. RETURN
  291. 'processes a character within an ansi escape sequence
  292. 'non-valid characters are sent to the screen
  293. ProcessCode:
  294.     SELECT CASE Char
  295.     CASE 48 TO 57                       '0-9
  296.         IF CurrentParameter < 100 THEN
  297.             CurrentParameter = CurrentParameter * 10 + (Char - 48)
  298.             ValidParameter = True
  299.         ELSE
  300.             GOSUB ProcessChar
  301.             Level = 0
  302.         END IF
  303.     CASE 59
  304.         GOSUB MakeParameter             '";"
  305.     'CUP-set cursor's position
  306.     CASE 72, 102                        'H or f
  307.         GOSUB MakeParameter
  308.         IF NumParameters = 0 THEN
  309.             Ynew = 1: Xnew = 1
  310.         ELSEIF NumParameters = 1 THEN
  311.             Ynew = Parameters(0): Xnew = 1
  312.         ELSE
  313.             Ynew = Parameters(0): Xnew = Parameters(1)
  314.         END IF
  315.         'the following if/then was split apart for echo
  316.         IF (Ynew >= MinY AND Ynew <= MaxY) THEN
  317.             IF (Xnew >= MinX AND Xnew <= MaxX) THEN
  318.                 Ypos = Ynew: Xpos = Xnew
  319.                 SetCursor
  320.             END IF
  321.         END IF
  322.         Level = 0
  323.     'CUU- cursor up
  324.     CASE 65                             'A
  325.         GOSUB MakeParameter
  326.         IF NumParameters = 0 THEN
  327.             Ynew = Ypos - 1
  328.         ELSE
  329.             Ynew = Ypos - Parameters(0)
  330.         END IF
  331.         IF NOT (Ynew < MinY OR Ynew > MaxY) THEN
  332.             Ypos = Ynew
  333.             SetCursor
  334.         END IF
  335.         Level = 0
  336.     'CUD-cursor down
  337.     CASE 66                             'B
  338.         GOSUB MakeParameter
  339.         IF NumParameters = 0 THEN
  340.             Ynew = Ypos + 1
  341.         ELSE
  342.             Ynew = Ypos + Parameters(0)
  343.         END IF
  344.         IF (Ynew >= MinY AND Ynew <= MaxY) THEN
  345.             Ypos = Ynew
  346.             SetCursor
  347.         END IF
  348.         Level = 0
  349.     'CUF-cursor forward
  350.     CASE 67                             'C
  351.         GOSUB MakeParameter
  352.         IF NumParameters = 0 THEN
  353.             Xpos = Xpos + 1
  354.         ELSE
  355.             Xpos = Xpos + Parameters(0)
  356.         END IF
  357.         IF Xpos > MaxX THEN Xpos = MaxX
  358.         SetCursor
  359.         Level = 0
  360.     'CUB-cursor backward
  361.     CASE 68                              'D
  362.         GOSUB MakeParameter
  363.         IF NumParameters = 0 THEN
  364.             Xpos = Xpos - 1
  365.         ELSE
  366.             Xpos = Xpos - Parameters(0)
  367.         END IF
  368.         IF Xpos < MinX THEN Xpos = MinX
  369.  
  370. '****PART 5****
  371.         SetCursor
  372.         Level = 0
  373.     'SCR-save cursor position
  374.     CASE 115                            's
  375.         SaveX = Xpos
  376.         SaveY = Ypos
  377.         Level = 0
  378.     'RCP-restore cursor position
  379.     CASE 117                            'u
  380.         Xpos = SaveX
  381.         Ypos = SaveY
  382.         Level = 0
  383.         SetCursor
  384.     'ED-erase display(ESC[2J and ESC[J work
  385.     'both work)
  386.     CASE 74                             'J
  387.         ClearScreen
  388.         Xpos = MinX: Ypos = MinY
  389.         Level = 0
  390.         SetCursor
  391.     'EL-erase in line
  392.     CASE 75                             'K
  393.         Y = Ypos * 160 - 160 - 2
  394.         'this could be optimized
  395.         FOR X = Xpos TO MaxX
  396.             A = X * 2 + Y
  397.             POKE A, 32: POKE A + 1, Attribute
  398.         NEXT
  399.         Level = 0
  400.     'SGR-sets new color
  401.     '(hopefully I handled the monochrome stuff
  402.     'correctly...)
  403.     CASE 109                            'm
  404.         GOSUB MakeParameter
  405.         FOR A = 0 TO NumParameters - 1
  406.             P = Parameters(A)
  407.             SELECT CASE P
  408.             CASE IS <= 8
  409.                 SELECT CASE P
  410.                 'all attributes off
  411.                 CASE 0
  412.                     Attribute = 7
  413.                 'high-intensity
  414.                 CASE 1
  415.                     Attribute = Attribute OR 8
  416.                 'blinking
  417.                 CASE 5
  418.                     Attribute = Attribute OR 128
  419.                 CASE 7
  420.                 'inverse video is not implemented at this time
  421.                 '...because I don't have the fuzziest idea what
  422.                 'it does!
  423.                 END SELECT
  424.                 'set foreground
  425.             CASE 30 TO 37
  426.                 IF NOT Monochrome THEN
  427.                     Attribute = (Attribute AND 248) OR Colors(P - 30)
  428.                 END IF
  429.                 'set background
  430.             CASE 40 TO 47
  431.                 IF NOT Monochrome THEN
  432.                     Attribute = (Attribute AND 143)
  433.                     Attribute = Attribute OR Colors(P - 40) * 16
  434.                 END IF
  435.             END SELECT
  436.         NEXT
  437.         Level = 0
  438.     'DSR-outputs a CPR sequence
  439.     'This function outputs the string "ESC[#;#R" where
  440.     '#;# is the current Y and current X coordinate
  441.     'to the receiver.
  442.     'Calls SendStatus to do it's dirty work...
  443.     CASE 110
  444.         SendStatus Xpos, Ypos
  445.         Level = 0
  446.     'any other code is assumed to be invalid
  447.     CASE ELSE
  448.         Level=0
  449.         GOSUB ProcessChar
  450.     END SELECT
  451. RETURN
  452. 'stores a numeric parameter into the parameter table
  453. MakeParameter:
  454.     'check to see if a least one digit has been received
  455.     'for this parameter
  456.     IF ValidParameter AND NumParameters < 5 THEN
  457.         'add parameter to table
  458.         Parameters(NumParameters) = CurrentParameter
  459.         NumParameters = NumParameters + 1
  460.         CurrentParameter = 0
  461.         ValidParameter = False
  462. '****PART 6****
  463.     END IF
  464. RETURN
  465. END SUB
  466.  
  467. 'Prints a string to the display.
  468. SUB printstring (B$)
  469.     A& = SADD(B$)
  470.     IF A& < 0 THEN A& = A& + 65536
  471.     Segment = VARSEG(B$) + A& \ 16
  472.     Address = A& MOD 16
  473.     FOR B = Address TO Address + LEN(B$) - 1
  474.         DEF SEG = Segment
  475.         A1 = PEEK(B)
  476.         'RestoreVs
  477.         DEF SEG = VideoSegment
  478.         PrintAnsi A1
  479.     NEXT
  480. END SUB
  481.  
  482. SUB RestoreVs
  483.     DEF SEG = VideoSegment
  484. END SUB
  485.  
  486. SUB ScrollUpScreen
  487.     DIM Regs AS RegType
  488.     Regs.Ax = &H601
  489.  
  490.     A& = Attribute * 256&
  491.     IF A& > 32767 THEN A = A& - 65536 ELSE A = A&
  492.     Regs.Bx = A
  493.  
  494.     Regs.Cx = (MinY * 256&) + MinX - 257
  495.     Regs.Dx = (MaxY * 256&) + MaxX - 257
  496.     CALL interrupt(&H10, Regs, Regs)
  497. END SUB
  498.  
  499. 'Sends the screen's status to the receiver. You must modify the
  500. '"PRINT #1, A$;" command to print to your comm package.
  501. 'Sends "ESC[##;##R" where ##;## is Y;X.
  502. SUB SendStatus (X, Y)
  503.     A$ = CHR$(27) + "[" + RIGHT$("0" + MID$(STR$(Y), 2), 2)
  504.     A$ = A$ + ";" + RIGHT$("0" + MID$(STR$(X), 2), 2) + "R"
  505.     '*****Change the next line for your comm package!!
  506.     '*****(as it stands it's set up to work correctly with
  507.     'PANSI3.BAS)*****
  508.     PRINT #1, A$;           'DON'T insert a line feed!!
  509.  
  510. END SUB
  511.  
  512. SUB SetCursor
  513.     IF CursorOn THEN
  514.     LOCATE Ypos, Xpos
  515.     END IF
  516. END SUB
  517.  
  518. 'Sets a new printing window.
  519. SUB SetWindow (Lx, Ly, Hx, Hy)
  520.     MinX = Lx: MaxX = Hx
  521.     MinY = Ly: MaxY = Hy
  522.     Xpos = MinX: Ypos = MinY
  523.     SetCursor
  524. END SUB
  525.  
  526. 'end of main program; example programs follow
  527.